home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbasicpg.zip / TYPE_EX.BAS < prev    next >
BASIC Source File  |  1988-09-17  |  2KB  |  77 lines
  1. '
  2. ' *** TYPE_EX.BAS -- TYPE statement programming example
  3. '
  4. TYPE Card
  5.    Value AS INTEGER
  6.    Suit AS STRING*9
  7. END TYPE
  8.  
  9. DEFINT A-Z
  10. ' Define the Deck as a 52-element array of Cards.
  11. DIM Deck(1 TO 52) AS Card
  12.  
  13. ' Build, shuffle, and deal the top five cards.
  14. CALL BuildDeck(Deck())
  15. CALL Shuffle(Deck())
  16. FOR I%=1 TO 5
  17.    CALL ShowCard(Deck(I%))
  18. NEXT I%
  19.  
  20. ' Build the deck--fill the array of Cards with
  21. ' appropriate values.
  22. SUB BuildDeck(Deck(1) AS Card) STATIC
  23. DIM Suits(4) AS STRING*9
  24.  
  25.    Suits(1)="Hearts"
  26.    Suits(2)="Clubs"
  27.    Suits(3)="Diamonds"
  28.    Suits(4)="Spades"
  29. ' This loop controls the suit.
  30.    FOR I%=1 TO 4
  31.     ' This loop controls the face value.
  32.       FOR J%=1 TO 13
  33.        ' Figure out which card (1...52) you're creating.
  34.          CardNum%=J%+(I%-1)*13
  35.        ' Place the face value and suit into the Card.
  36.          Deck(CardNum%).Value=J%
  37.          Deck(CardNum%).Suit=Suits(I%)
  38.       NEXT J%
  39.    NEXT I%
  40.  
  41. END SUB
  42.  
  43. ' Shuffle a deck (an array containing Card elements).
  44. SUB Shuffle(Deck(1) AS Card) STATIC
  45.  
  46.    RANDOMIZE TIMER
  47. ' Shuffle by transposing 1000 randomly selected pairs of cards.
  48.    FOR I%=1 TO 1000
  49.       CardOne%=INT(52*RND+1)
  50.       CardTwo%=INT(52*RND+1)
  51.    ' Notice that SWAP works on arrays of user types.
  52.       SWAP Deck(CardOne%),Deck(CardTwo%)
  53.    NEXT I%
  54.  
  55. END SUB
  56.  
  57. ' Display a single card by converting and printing the
  58. ' face value and the suit.
  59. SUB ShowCard (SingleCard AS Card) STATIC
  60.  
  61.    SELECT CASE SingleCard.Value
  62.       CASE 13
  63.          PRINT "King ";
  64.       CASE 12
  65.          PRINT "Queen";
  66.       CASE 11
  67.          PRINT "Jack ";
  68.       CASE  1
  69.          PRINT "Ace  ";
  70.       CASE ELSE
  71.          PRINT USING "  ## ";SingleCard.Value;
  72.    END SELECT
  73.  
  74.    PRINT " ";SingleCard.Suit
  75.  
  76. END SUB
  77.